      SUBROUTINE ADMIMP(NZ,ZDEL,VALUE,DERN,UPBND,DNBND,FACTOR,FREQ,
     .HLIMIT,LZ,ZXINDE,DELMIT)
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
C        'ADMIMP' IS THE ADAMS-MOULTON INTEGRATOR.  THE FIRST FOUR
C        POINTS ARE CALCULATED USING A RUNGE-KUTTA SCHEME.
C
      COMMON/IAFSD/DELMAX,DELMIN,KCUT(150),NCUT,NUP
C
      COMMON/ICSADM/L
C
      DIMENSION ZBAR(150),DIF(150),VALUE(150),DERNN(150),DERN(150),
     .   DERNM1(150),DERNM2(150),DERNM3(150),VALUEN(150),B0(150),
     .   B1(150),UPBND(150),DNBND(150),SAVD(150),SAVE(150)
C
      N=NZ
      L=LZ
      DEL=ZDEL
      XINDEP=ZXINDE
      IF(DELMIT) 3,2,3
    2 DELMIT=DEL/1000.0D0
    3 CONTINUE
      IF(L) 1210,201,1211
 1210 L=IABS(L)
      GO TO 23
 1211 GO TO (23,204,204,204,24),L
  204 DO 205 JJ=1,N
      DERN(JJ)=SAVD(JJ)
      VALUE(JJ)=SAVE(JJ)
  205 CONTINUE
      XINDEP=SINDEP
      GO TO 24
   23 XFREQ=XINDEP+FREQ
      LL=2
      SAVDEL=DEL
      SINDEP=XINDEP
      ASSIGN 41 TO M
      CALL DEREQ1(VALUE,XINDEP,DERN)
      GO TO 40
   24 GO TO M,(41,42)
   41 DO 62 KK=1,N
      DERNM3(KK)=DERN(KK)
   62 CONTINUE
      DO 43 NN=1,3
      W1=DEL/2.0D0
      DO 44 I=1,N
      B0(I)=0.0D0
   44 CONTINUE
      DO 50 J=1,4
      GO TO (45,46,48,49),J
   45 DIV1=6.0D0
   47 DIV2=2.0D0
      H=W1
      GO TO 60
   46 DIV1=3.0D0
      GO TO 47
   48 DIV1=3.0D0
      DIV2=1.0D0
      H=DEL
      GO TO 60
   49 DIV1=6.0D0
   60 DO 51 I=1,N
      B1(I)=DERN(I)*DEL
      B0(I)=B0(I)+B1(I)/DIV1
      GO TO (52,52,52,53),J
   52 VALUEN(I)=VALUE(I)+B1(I)/DIV2
      TINDEP=XINDEP+H
      GO TO 51
   53 VALUEN(I)=VALUE(I)+B0(I)
   51 CONTINUE
   54 CALL DEREQ1(VALUEN,TINDEP,DERN)
   50 CONTINUE
      DO 61 II=1,N
      GO TO (63,64,65),NN
   63 DERNM2(II)=DERN(II)
      GO TO 65
   64 DERNM1(II)=DERN(II)
   65 VALUE(II)=VALUEN(II)
   61 CONTINUE
      XINDEP=TINDEP
43    CALL RWHOUT
      H1=DEL
      H2=DEL
      H3=DEL
      ASSIGN 42 TO M
      GO TO 9042
   42 CONTINUE
      XFREQ=XFREQ+FREQ
 9042 CONTINUE
      GO TO (1406,1407,1407,1407,1207),L
 1407 IF (DABS(XINDEP-XFREQ)-DABS(DEL)) 1408,1408,1455
 1455 IF(DABS(XINDEP-HLIMIT)-DABS(DEL)) 1408,1408,1406
 1408 CONTINUE
      DO 1410 IJK=1,N
      ZBAR(IJK)=VALUE(IJK)
      DERNN(IJK)=DERN(IJK)
      DERN(IJK)=DERNM1(IJK)
      DERNM1(IJK)=DERNM2(IJK)
      DERNM2(IJK)=DERNM3(IJK)
 1410 CONTINUE
      LL=1
   11 TEMP=DABS(XINDEP-XFREQ)
      IF(TEMP-DABS(DEL)) 16,16,15
   16 L=2
      SINDEP=XINDEP
      SAVDEL=DEL
      TEMP1=DABS(DEL)/DEL
      DEL=TEMP*TEMP1
   15 TEMP=DABS(XINDEP-HLIMIT)
      IF(TEMP-DABS(DEL)) 118,18,17
  118 L=1
   18 L=L+2
      SAVDEL=DEL
      TEMP1=DABS(DEL)/DEL
      DEL=TEMP*TEMP1
   17 GO TO (22,6,6,6,22),L
 1406 CONTINUE
      LL=1
      L=1
 1207 CONTINUE
   12 W1=H1+H2
      W2=W1*W1
      W3=W1+H1
      W4=W1+H3
      W5=W4+W1
      W6=W4+W3
      W7=W3+H3
      W8=W1*H1
      W9=W1*H3
      W10=H2+H3
      W11=H2*H3
      W12=H1*H2
      W16=W2+W9
      GO TO (14,202,202,202,14),L
   14 TEMP=XINDEP+DEL
      DEL=TEMP-XINDEP
      IF(DABS(DEL)-DABS(DELMIT)) 201,202,202
  201 CONTINUE
      L=6
      GO TO 4
  202 XINDEP=XINDEP+DEL
      W13=DEL/2.0D0
      W14=W13*W13*DEL
      W15=DEL*DEL/3.0D0
      W17=H1+DEL
      W18=W1+DEL
      W19=W1*DEL
      W29=W3*DEL
      B0(1)=(DEL/W4)*(W14+W15*W6+W13*(W2+2.0D0*H1*W4+W11)+H1*W16)/W8
      B1(1)=-DEL/W10*(W14+W15*W5+W13*W16)/W12
      B2=DEL*(W14+W15*W7+W13*H1*W4)/(W1*W11)
      B3=-DEL*(W14+W15*W3+W13*W8)/(W4*W10*H3)
      DO 1544 I=1,N
      ZBAR(I) =VALUE(I)+B0(1)*DERN(I)+B1(1)*DERNM1(I)+B2*DERNM2(I)+B3
     . *DERNM3(I)
 1544 CONTINUE
      CALL DEREQ1(ZBAR,XINDEP,DERNN)
      A=(W14+W15*W3+W13*W8)/(W17*W18)
      A0=-(W14+W15*(W3-DEL)+W13*(W8-W29)-DEL*W8)/W8
      A1=DEL*(W14+W15*(W1-DEL)-W13*W19)/(W12*W17)
      A2=DEL*(W14/3.0D0+H1*W15/2.0D0)/(W1*W18*H2)
      DO 13 I=1,N
      VALUEN(I)=VALUE(I)+A*DERNN(I)+A0*DERN(I)+A1*DERNM1(I)+A2*DERNM2(I)
      DIF(I)=DABS(VALUEN(I)-ZBAR(I))
      IF(DIF(I)-UPBND(I)) 13,13,759
  759 XINDEP=XINDEP-DEL
      DEL=DEL-FACTOR*DEL
      IF(DELMIN.GT.DEL) DELMIN=DEL
      KCUT(I)=KCUT(I)+1
      IF(L-5) 7000,14,220
 7000 CONTINUE
      L=1
      LL=1
      GO TO 14
   13 CONTINUE
      IF(L-2) 500,5,500
  500 CONTINUE
      H3=H2
      H2=H1
      H1=DEL
      GO TO (11,5,5,5,22),L
  200 SAVDEL=DEL
      GO TO 21
   22 DO 19 K=1,N
      IF(DIF(K)-DNBND(K)) 19,19,7010
   19 CONTINUE
      DEL=DEL+DEL*FACTOR
      IF(DELMAX.LT.DEL) DELMAX=DEL
      NUP=NUP+1
7010  CALL RWHOUT
      IF(L-5) 6,200,220
    5 CONTINUE
      DO 1040 LLL=1,N
      VALUE(LLL)=ZBAR(LLL)
1040  DERN(LLL)=DERNN(LLL)
   21 LL=2
      GO TO (6,40,40,40,6),L
    6 DO 8 J=1,N
      DERNM3(J)=DERNM2(J)
      DERNM2(J)=DERNM1(J)
      DERNM1(J)=DERN(J)
      DERN(J)=DERNN(J)
      VALUE(J)=ZBAR(J)
    8 CONTINUE
   40 CONTINUE
      GO TO (212,208,208,208,209),L
  212 CONTINUE
      GO TO (1407,1206),LL
 1206 L=2
      GO TO 206
  208 CONTINUE
      GO TO (206,4),LL
  206 CONTINUE
      DO 203 JJJ=1,N
      SAVD(JJJ)=DERN(JJJ)
      SAVE(JJJ)=VALUE(JJJ)
  203 CONTINUE
  209 CONTINUE
      GO TO (12,4),LL
    4 DEL=SAVDEL
  220 NZ=N
      LZ=L
      ZDEL=DEL
      ZXINDE=XINDEP
      RETURN
      END
